home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue26 / tiptrix / Vinfo / UABOUT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-08-24  |  1.7 KB  |  72 lines
  1. unit UAbout;
  2.  
  3. interface
  4.  
  5. uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  6.   Buttons, ExtCtrls;
  7.  
  8. type
  9.   TAboutBox = class(TForm)
  10.     Panel1: TPanel;
  11.     ProgramIcon: TImage;
  12.     ProductName: TLabel;
  13.     Version: TLabel;
  14.     Copyright: TLabel;
  15.     OKButton: TButton;
  16.   private
  17.     { Private declarations }
  18.   protected
  19.     function GetAppVersion: string;
  20.   public
  21.     { Public declarations }
  22.     constructor Create(Owner: TComponent); override;
  23.   end;
  24.  
  25. var
  26.   AboutBox: TAboutBox;
  27.  
  28. implementation
  29.  
  30. {$R *.DFM}
  31.  
  32. function TAboutBox.GetAppVersion: string;
  33. var
  34.   ptrBlock, verInfo: Pointer;
  35.   verInfoSize, tmp: integer;
  36.   FileName: array[0..260] of Char;
  37. begin
  38.   Result := '';
  39.   GetModuleFileName(0, FileName, SizeOf(FileName)); // Get host application name
  40.   // version resource querying
  41.   verInfoSize := GetFileVersionInfoSize(FileName, tmp);
  42.   if verInfoSize > 0 then begin
  43.     ptrBlock := AllocMem(verInfoSize);
  44.     try
  45.       GetFileVersionInfo(FileName, 0, verInfoSize, ptrBlock);
  46.       VerQueryValue(ptrBlock, '\', verInfo, tmp);
  47.       with PVSFixedFileInfo(verInfo)^ do
  48.         Result := ' Version ' +
  49.           IntToStr(dwProductVersionMS div 65536) + '.' +
  50.           IntToStr(dwProductVersionMS mod 65536) + '.' +
  51.           IntToStr(dwProductVersionLS div 65536) + '.' +
  52.           IntToStr(dwProductVersionLS mod 65536);
  53.     finally
  54.       FreeMem(ptrBlock);
  55.     end;
  56.   end;
  57. end;
  58.  
  59. constructor TAboutBox.Create(Owner: TComponent);
  60. begin
  61.   inherited Create(Owner);
  62.   ProductName.Caption := Application.Title;
  63.   try
  64.     Version.Caption := GetAppVersion;
  65.   except
  66.     Version.Caption := '(No version info)'
  67.   end;
  68. end;
  69.  
  70. end.
  71.  
  72.